Celestin Apprentice 5/Apprentice-Release5.iso/Environments/SmallEiffel 0.3.3/SmallEiffel 68k/lib_std/general.e

Text File | 1996-06-13 | 16.1 KB | 641 lines | [TEXT/EDIT]

-- Part of SmallEiffel -- Read DISCLAIMER file -- Copyright (C)
-- Dominique COLNET and Suzanne COLLIN -- [e-mail]
--
class GENERAL
--
-- Platform-independent universal properties.
-- This class is an ancestor to all developer-written classes.
--

feature -- Access :

   generating_type: STRING is
     -- Name of current object's generating type (type of
     -- which it is a direct instance).
      external "CSE"
      end;

   generator: STRING is
     -- Name of current object's generating class (base class
     -- of the type of witch it is a direct instance).
      external "CSE"
      end;

   id_object(id: INTEGER): ANY is
     -- Object for wich `object_id' has returened `id'.
     -- Void if none.
      require
     id /= 0;
      do
     c_inline_c("R=((T0 *)a1);");
      end;

   object_id: INTEGER is
     -- Value identifying current reference object.
      require
     not is_expanded_type
      do
     c_inline_c("R=((int)C);")
      end;

   stripped(other: GENERAL): like other is
     -- New created object with fields copied from current object, but
     -- limited to attributes of type of `other'.
      require
     conformance: conforms_to(other);
      do
     not_yet_implemented;
      ensure
     stripped_to_other: Result.same_type(other);
      end;

feature -- Status report :

   frozen conforms_to(other: GENERAL): BOOLEAN is
     -- Does type of current object conform to type of other
     -- (as per Eiffel: The Language, chapter 13) ?
      require
     other_not_void: other /= Void;
      do
     not_yet_implemented;
      end;

   frozen same_type(other: GENERAL): BOOLEAN is
     -- Is type of current object identical to type of other.
      require
     other_not_void: other /= Void;
      do
     if not is_expanded_type then
        c_inline_c("R=((C->id)==(a1->id));");
     end;
      ensure
--     definition: Result = (conforms_to(other) and
--                   other.conforms_to(Current));
      end;

feature -- Comparison :

   frozen deep_equal(some: GENERAL; other: like some): BOOLEAN is
      do
     if some = other then
        Result := true;
     elseif some = Void then
     elseif other = Void then
     elseif standard_equal(some,other) then
        Result := true;
     else
        not_yet_implemented;
     end;
      ensure
     shallow_implies_deep: standard_equal(some,other)
                   implies Result;
     same_type: Result implies some.same_type(other);
     symmetric: Result implies deep_equal(other,some);
      end;

   frozen equal(some: ANY; other: like some): BOOLEAN is
     -- Are `some' and `other' both Void or attached to
     -- objects considered equal ?
      do
     if some = other then
        Result := true;
     elseif some = Void then
     elseif other = Void then
     else
        Result := some.is_equal(other);
     end;
      ensure
     definition: Result = (some = Void and other = Void) or else
             ((some /= Void and other /= Void) and then
              some.is_equal(other));
      end;

   is_equal(other: like Current): BOOLEAN is
     -- Is `other' attached to an object considered equal to
     -- current object ?
      require
     other_not_void: other /= Void
      do
     Result := standard_is_equal(other);
      ensure
     consistent: standard_is_equal(other) implies Result;
-- ***     same_type: Result implies same_type(other);
-- ELKS95 bug for expanded target.
     symmetric: Result implies other.is_equal(Current);
      end;

   frozen standard_equal(some: ANY; other: like some): BOOLEAN is
     -- Are `some' and `other' both Void or attached to
     -- field-by-field objects of the same type ?
     -- Always use the default object comparison criterion.
      do
     if some = other then
        Result := true;
     elseif some = Void then
     elseif other = Void then
     elseif some.same_type(other) then
        Result := some.standard_is_equal(other);
     end;
      ensure
     definition: Result = (some = Void and other = Void) or else
             ((some /= Void and other /= Void) and then
              some.standard_is_equal(other));
      end;

   frozen standard_is_equal(other: like Current): BOOLEAN is
     -- Are Current and `other' field-by-field identical?
      require
     other /= Void
      do
     if is_expanded_type then
        Result := other = Current;
     elseif other = Current then
        Result := true;
     else
        c_inline_c("R=!memcmp(C,a1,s[C->id]);");
     end;
      ensure
-- ***     same_type: Result implies same_type(other);
-- ELKS95 bug for expanded target.
     symmetric: Result implies other.standard_is_equal(Current);
      end;

feature -- Duplication :

   frozen clone(other: ANY): like other is
     -- When argument `other' is Void, return Void
     -- otherwise return `other.twin'.
      do
     if other /= Void then
        Result := other.twin;
     end;
      ensure
     equal: equal(Result,other);
      end;

   frozen twin: like Current is
     -- Return an initialized new object using target as model.
     -- Result as the same `generating_type' as the target of the
     -- call. Before to be returned, the corresponding `copy' feature
     -- is called.
      do
     if is_expanded_type then
        if is_basic_expanded_type then
           Result := Current;
        else
           Result := Current;
           Result.copy(Current);
        end;
     else
        c_inline_c("R=(T0 *)se_new(C->id);AF_1");
        Result.copy(Current);
        c_inline_c("AF_0");
     end;
      ensure
     equal: Result.is_equal(Current);
      end;

   copy(other: like Current) is
     -- Update current object using fields of object attached
     -- to `other', so as to yield equal objects.
      require
     other_not_void: other /= Void;
     type_identity: same_type(other);
      do
     if is_expanded_type then
        c_inline_c("C=a1;");
     else
        c_inline_c("memcpy(C,a1,s[C->id]);");
     end;
      ensure
     is_equal: is_equal(other)
      end;

   frozen deep_clone(other: GENERAL): like other is
     -- Void if `other' is Void: otherwise, new object structure
     -- recursively duplicated from the one attached to other.
      do
     not_yet_implemented;
      ensure
     deep_equal: deep_equal(other,Result);
      end;

   frozen standard_clone(other: ANY): like other is
     -- Void if `other' is Void; otherwise new object
     -- field-by-field identical to `other'.
     -- Always use the default copying semantics.
      do
     if other /= Void then
        c_inline_c("R=(T0 *)se_new(a1->id);%N%
               %memcpy(R,a1,s[a1->id]);");
     end;
      ensure
     equal: standard_equal(Result,other);
      end;

    frozen standard_copy(other: like Current) is
     -- Copy every field of `other' onto corresponding
     -- field of curent object.
      require
     other_not_void: other /= Void;
     type_identity: same_type(other);
      do
     c_inline_c("memcpy(C,a1,s[a1->id]);");
      ensure
     is_standard_equal: standard_is_equal(other);
      end;

feature -- Basic operations :

   frozen default: like Current is
     -- Default value of current type.
      do
      end;

   frozen default_pointer: POINTER is
     -- Default value of type POINTER (avoid the need to
      -- write p.default for some `p' of type POINTER).
      do
      ensure
     Result = Result.default;
      end;

   default_rescue is
     -- Handle exception if no Rescue clause (default do
     -- nothing).
      do
      end;

   frozen do_nothing is
     -- Execute a null action.
      do
      end;

   frozen Void: NONE is
      -- Void reference.
      external "CSE"
      end;

feature -- Input and Output :

   frozen io: STD_INPUT_OUTPUT is
     -- Handle to standard file setup.
     -- To use the standard input/output file.
      once
     !!Result.make;
      ensure
     Result /= Void;
      end;

   frozen std_input: STD_INPUT is
     -- To use the standard input file.
      once
     !!Result.make;
      end;

   frozen std_output: STD_OUTPUT is
     -- To use the standard output file.
      once
     !!Result.make;
      end;

   frozen std_error: STD_ERROR is
     -- To use the standard error file.
      once
     !!Result.make;
      end;

feature -- Object Printing :

   print(some: GENERAL) is
     -- Write terse external representation of `some' on
     -- `standard_output'.
     -- This routine is automatically called to print the stack
     -- when system `crash'. As user can redefine `print',
     -- `print_on' or `fill_tagged_out_memory', it is better to
     --  be sure not to have a second `crash'.
      do
     if some = Void then
        std_output.put_string("Void");
     else
        some.print_on(std_output);
     end;
      end;

   print_on(file: STD_FILE_WRITE) is
     -- Default printing of current object.
      do
     tagged_out_memory.clear;
     out_in_tagged_out_memory;
     file.put_string(tagged_out_memory);
      end;

   frozen tagged_out: STRING is
     -- New string containing printable representation of current
     -- object, each field preceded by its attribute name, a
     -- colon and a space.
      do
     tagged_out_memory.clear;
     fill_tagged_out_memory;
     Result := tagged_out_memory.twin;
      end;

   out: STRING is
     -- Create a new string containing terse printable
     -- representation of current object;
      do
     tagged_out_memory.clear;
     out_in_tagged_out_memory;
     Result := tagged_out_memory.twin;
      end;

   out_in_tagged_out_memory is
      -- Append terse printable represention of current object
      -- in `tagged_out_memory';
      do
     if is_basic_expanded_type then
        fill_tagged_out_memory;
     else
        tagged_out_memory.append(generating_type);
        if not is_expanded_type then
           tagged_out_memory.extend('#');
           object_id.append_in(tagged_out_memory);
        end;
        tagged_out_memory.extend('[');
        fill_tagged_out_memory;
        tagged_out_memory.extend(']');
     end;
      end;

   frozen tagged_out_memory: STRING is
      once
     !!Result.make(1024);
      end;

   fill_tagged_out_memory is
     -- Note : can be redefine to change printing of stack
     --        when system crash.
      do
      end;

feature -- Named file handling :

   file_exists(path: STRING): BOOLEAN is
      require
     path /= Void;
      local
     p: POINTER;
      do
     p := path.to_external;
     c_inline_c(
         "{FILE *f=fopen(((char*)_p),%"r%");%N%
     %R=(f != NULL);%N%
     %if (R) fclose(f);}");
      end;

   remove_file(path: STRING) is
      require
     path /= Void;
      local
     p: POINTER;
      do
     p := path.to_external;
     c_inline_c("remove(((char*)_p));");
      end;

   rename_file(old_path, new_path: STRING) is
      require
     old_path /= Void;
     new_path /= Void;
      local
     op, np: POINTER;
      do
     op := old_path.to_external;
     np := new_path.to_external;
     c_inline_c("rename(((char*)_op),((char*)_np));");
      end;

feature -- Access to command-line arguments :

   argument_count: INTEGER is
     -- Number of arguments given to command that started
     -- system execution (command name does not count).
      do
     Result := command_arguments.upper;
      ensure
     Result >= 0;
      end;

   argument(i: INTEGER): STRING is
     -- `i' th argument of command that started system execution
     -- Gives the command name if `i' is 0.
      require
     i >= 0;
     i <= argument_count;
      do
     Result := command_arguments.item(i);
      ensure
     Result /= Void
      end;

   frozen command_arguments: ARRAY[STRING] is
     --                  ***** FIXED_ARRAY[STRING]
     -- Give an acces to arguments command line including the
     -- command name at index 0.
      local
     i: INTEGER;
     arg: STRING;
      once
     from
        c_inline_c("_i=se_argc-1;");
        !!Result.make(0,i);
     until
        i < 0
     loop
        c_inline_c("_arg=((T0*)e2s(se_argv[_i]));");
        Result.put(arg,i);
        i := i - 1;
     end;
      ensure
     Result.lower = 0; -- *****  FIXED_ARRAY
     not Result.empty
      end;

   get_environment_variable(name: STRING): STRING is
     -- To get the value of a system environment variable
     -- (like "PATH" on Unix for example).
     -- Gives Void when system variable `name' is undefined.
      require
     name /= Void
      local
     p: POINTER;
      do
     p := name.to_external;
     c_inline_c("_p=((void*)getenv((char*)_p));");
     if p.is_not_void then
        c_inline_c("R=(T0*)e2s((char*)_p);");
     end;
      ensure
     Result /= Void implies not Result.empty
      end;

feature -- System calls and crashing :

   system(cmd: STRING) is
     -- To execute a `cmd' at system level.
     -- For example, "ls -l" on UNIX.
      local
     p: POINTER;
      do
     p := cmd.to_external;
     c_inline_c("system(((char*)_p));");
      end;

   frozen crash is
     -- Print Run Time Stack (unless "-boost" mode)
     -- and then exit with `exit_failure_code'.
     -- See also `print'.
      do
     c_inline_c("rsp();");
     die_with_code(exit_failure_code);
      end;

   frozen die_with_code(code:INTEGER) is
     -- Terminate execution with exit status code `code'.
     -- Do not print any message.
      require
     code = exit_success_code or else
     code = exit_failure_code;
      do
     c_inline_c("exit(a1);");
      end;

   exit_success_code: INTEGER is 0;

   exit_failure_code: INTEGER is 1;

feature -- Maths constants :

   Pi: DOUBLE is 3.1415926535897932384626;

   Evalue: DOUBLE is  2.71828182845904523536;

   Deg: DOUBLE is 57.295780; -- Deg/Radian.

   Phi: DOUBLE is 1.618034; -- Golden Ratio.

feature -- Character names :

   Ctrl_a: CHARACTER is '%/1/';
   Ctrl_b: CHARACTER is '%/2/';
   Ctrl_c: CHARACTER is '%/3/';
   Ctrl_d: CHARACTER is '%/4/';
   Ctrl_e: CHARACTER is '%/5/';
   Ctrl_f: CHARACTER is '%/6/';
   Ctrl_g: CHARACTER is '%/7/';
   Ch_del: CHARACTER is '%/8/';
   Ch_tab: CHARACTER is '%/9/';
   Ctrl_j: CHARACTER is '%/10/';
   Ctrl_k: CHARACTER is '%/11/';
   Ctrl_l: CHARACTER is '%/12/';
   Ctrl_m: CHARACTER is '%/13/';
   Ctrl_n: CHARACTER is '%/14/';
   Ctrl_o: CHARACTER is '%/15/';
   Ctrl_p: CHARACTER is '%/16/';
   Ctrl_q: CHARACTER is '%/17/';
   Ctrl_r: CHARACTER is '%/18/';
   Ctrl_s: CHARACTER is '%/19/';
   Ctrl_t: CHARACTER is '%/20/';
   Ctrl_u: CHARACTER is '%/21/';
   Ctrl_v: CHARACTER is '%/22/';
   Ctrl_w: CHARACTER is '%/23/';
   Ctrl_x: CHARACTER is '%/24/';
   Ctrl_y: CHARACTER is '%/25/';
   Ctrl_z: CHARACTER is '%/26/';

feature -- Hashing :

   hash_code: INTEGER is
      external "CSE"
      ensure
     non_negative: Result >= 0
      end;

feature -- Should not exist :

   not_yet_implemented is
      do
     std_error.put_string(
      "Sorry, Some Feature is Not Yet Implemented.%N%
       %Please, if you can write it by yourself and if you send me%N%
       %the corresponding tested Eiffel code, I may put it in the%N%
       %standard library!%N%
       %Many Thanks in advance.%N%
       %D.Colnet e-mail: [e-mail]%N");
     crash;
       end;

feature {ANY} -- WARNING: For SmallEiffel Users's only.
   -- Using following features could makes your Eiffel code not
   -- portable on other Eiffel compilers.

   frozen is_expanded_type: BOOLEAN is
     -- Target is not evaluated (Statically computed).
     -- Result is true if target static type is an expanded type.
     -- Usefull for formal generic type.
      external "CSE"
      end;

   frozen is_basic_expanded_type: BOOLEAN is
     -- Target is not evaluated (Statically computed).
     -- Result is true if target static type is one of the
     -- following types : BOOLEAN, CHARACTER, INTEGER, REAL,
     -- DOUBLE or POINTER.
      external "CSE"
      ensure
     Result implies is_expanded_type
      end;

   object_size: INTEGER is
     -- Gives the size of the current object at first level
     -- only (pointed sub-object are not concerned).
     -- The result is given in number of CHARACTER.
      do
     if is_expanded_type then
        c_inline_c("R=sizeof(C);")
     else
        c_inline_c("R=s[C->id];")
     end;
      end;

feature {NONE} -- WARNING: For SmallEiffel Gurus's only.
   -- Using following features makes your Eiffel code not
   -- portable on other Eiffel compilers.

   c_inline_h(c_code: STRING) is
     -- Target must be Current and `c_code' must be a manifest
     -- string. Write `c_code' in the heading C file.
      external "CSE"
      end;

   c_inline_c(c_code: STRING) is
     -- Target must be Current and `c_code' must be a manifest
     -- string. Write `c_code' in the stream at current position.
      external "CSE"
      end;

feature -- WARNING: For SmallEiffel Gurus's only.
   -- Internal implementation of the SmallEiffel
   -- debugger/interpretor (command `eval').

   eval_read_attribute(name: STRING; dest: POINTER) is do end;

   eval_write_attribute(name: STRING; source: POINTER) is do end;

   frozen eval_virtual_machine: EVAL_VIRTUAL_MACHINE is
      once
     !!Result.make;
      end;

end -- GENERAL